perm filename GEOMED.FAI[GEM,HE]1 blob
sn#059957 filedate 1973-08-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00041 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
C00011 00003 EDITOR STATUS.
C00014 00004 START ADDRESS INITIALIZATION-------------------------------------
C00016 00005 ASCII 00 TO 37--------------------------------------------------
C00019 00006 ASCII 40 TO 100-------------------------------------------------
C00022 00007 ASCII 101 TO 132 UPPER CASE-------------------------------------
C00025 00008 SUBR(VBODY) MAKE VERTEX BODY.
C00028 00009 SUBR(MIDPOI) "M" MIDPOINT AN EDGE PROPORTIONAL TO DDEL.
C00030 00010 SUBR(EUTRAN)
C00032 00011 ----- EUTRAN MAKE REFERENCE FRAME.
C00035 00012 SWITCH COMMANDS.
C00038 00013 STACK MODIFYING COMMANDS. "↔↓↑"
C00040 00014 STRENGTH COMMANDS.
C00043 00015 SUBR(XSWEEP)
C00045 00016 SUBR XKILL "K"
C00047 00017 SUBR LINKER LINK FOLLOWING COMANDS.
C00049 00018 ----- LINKER OTHER LINK COMMANDS.
C00052 00019 COMMANDS XNAME,XBODY "B","N"
C00054 00020 SUBR RDNAME
C00056 00021 SUBR(INSTANT)
C00058 00022 XDPY:
C00061 00023 XBIN:
C00064 00024 SUBR(NEWMAC)
C00067 00025 XTEXT: TEXT COMMAND.
C00069 00026 SUBR(EXTEND) "X"-EXTEND COMMANDS.
C00071 00027 EXTEND COMMAND EXECUTIONS.
C00073 00028 SUBR(XSCROL) SCROLL CAMERA VISIBLE EDGES.
C00075 00029 SUBR(XCOLOR) COLORING X-COMMAND.
C00078 00030 SUBR(XARROW)
C00083 00031 SUBR(STADPY) STATUS DISPLAY
C00085 00032 ----- STADPY TRANSLATION STRENGTH.
C00087 00033 ----- STADPY DISPLAY THE SCRATCH PAD PDL.
C00089 00034 SUBR(NTYPE,NODE) FETCH NODE TYPE NUMBER 0 TO 17.
C00091 00035 TABLES REL,CONTYP,NNAMES,NLETTER Node Info. Tables
C00094 00036 NODE CONTENT TYPES.
C00096 00037 SUBR(DPYNODE,NODE) DISPLAY NODE CONTENTS.
C00098 00038 FULL WORD.
C00100 00039 SUBR(VDPY,VERTEX) SPECIAL VERTEX DISPLAY *
C00102 00040 SUBR(FDPY,FACE) Special Face display *
C00104 00041 SUBR(IDPY,NODE) Identifier display. *
C00106 ENDMK
C⊗;
TITLE GEOMED - GEOMETRIC EDITOR - BGB - JANUARY 1973.
SUBR GEOMED ;TELETYPE COMMAND JUMP TABLE
COMMENT ⊗------------------------------------------------------------
⊗
IFN SAIL,{DAC 12,SAIL12↔DAC 16,SAIL16}
L0: CRLF
L1: OUTCHR["*"] ;GEOMED'S EAR TOP LEVEL.
L2: CALL(STADPY) ;STATUS DISPLAY.
LAC ALPHA↔DAC CTRL↔SETZM ALPHA
LAC BETA ↔DAC META↔SETZM BETA
CALL(GETCW0)
TRZE 200↔SETOM CTRL ;CONTROL-KEY FLAG.
TRZE 400↔SETOM META ;META-KEY FLAG.
CAIN 0,15↔GO[SETZM ITERAT↔GO L2];CARRIAGE RETURN.
CAIN 0,12↔GO L1 ;LINE-FEED.
DAC 0,CHR
LAC CTRL↔AND META↔DAC MTCT ;META-CONTROL FLAG.
SETZ↔SKIPE CTRL↔IORI 1
SKIPE META↔IORI 2↔DAC MCBITS ;META-CONTROL BITS.
;READ JUMP TABLE.
LAC CHR↔DAC 1
CAIG 0,140↔GO[CAR 1,A00(1)↔GO L3]
CAIG 0,172↔GO[CAR 1,A00-40(1)↔GO L3]
CAR 1,A173-173(1)
L3: PUSHJ P,(1) ;CALL GEOMED COMMAND - THE CHARACTER IS IN AC0.
GO L2 ;NO-SKIP IMMEDIATE COMMAND.
GO L0 ;SKIP CRLF-STAR COMMAND.
ENDR GEOMED;2/4/73(BGB)----------------------------------------------
;COMMAND COMMAND EXITS.
DEFINE EXIT0{GO EXIT0.}
DEFINE EXIT1{GO EXIT1.}
DEFINE EXIT2{GO EXIT2.}
DEFINE EXIT3{GO EXIT3.}
EXIT0.: CRLF↔OUTCHR["*"]↔POP0J ;CRLF STAR.
EXIT1.: CALL(GEODPY)
POP0J ;REFRESH POP.
EXIT2.: LAC 2,PDLPTR↔PUSH 2,1↔DAC 2,PDLPTR↔EXIT1 ;PDL PUSH REFRESH.
EXIT3.: POP0J
NOP: OUTCHR CHR↔OUTSTR[ASCIZ/ NO OPERATION./]↔CRLF↔POP0J
QMARK: CALL(GETCW0)↔DAC 1
CAIG 0,140↔GO[CDR 1,A00(1)↔GO L4]
CAIG 0,172↔GO[CDR 1,A00-40(1)↔GO L4]
CDR 1,A173-173(1)
L4: CRLF↔OUTCHR[" "]
OUTSTR(1) ;PRINT GEOMED COMMAND CHARACTER COMMENT.
CRLF↔OUTCHR["*"]↔POP0J
;EDITOR STATUS.
PDL↑: BLOCK =500 ;GEOMED'S INTERNAL STACK.
PDLIOWD: XWD PDL-.,PDL-1
PAT↑: BLOCK 40
PDLPTR↑: XWD -100,PADPDL ;GEOMED'S GRAPHICS STACK.
PADPDL: BLOCK 100
↓PTR←←16 ;PADPDL STACK POINTER AC.
;JUMP TABLE COMMAND SCANNER STATUS.
DECLARE{CHR,MCBITS,CTRL,META,MTCT,ALPHA,BETA}
INTERN CTRL,META
;STRENGTH OF EUCLIDEAN TRANSFORMATION.
TDEL: 1.0 ;TRANSLATION DELTA STRENGTH.
RDEL: 0.785398;ROTATION DELTA STRENGTH.
DDEL: 0↔0.75 ;DILATION DELTA STRENGTH.
OPERAT: 0 ;DEFAULT EUCLIDEAN OPERATION.
FRAAM: 0 ;FRAME OF REFERENCE.
FRMORG: 0 ;USE FRAME OF REFERENCE ORIGIN.
AXECNT: 1 ;NUMBER OF AXES TO USE.
ITERAT: 0 ;NUMBER OF ITERATIONS.
FLAGL: -1 ;"L" COMMAND SWITCH. LABEL LIGHTS.
FLAGD: 0 ;"∂" NODE DISPLAY ENABLE.
FLAGSD: -1 ;"≡" STATUS DISPLAY ENABLE.
DPYFLG↑:2 ;GEODPY STICKY DISPLAY MODE.
ODPYFLG: 2 ;OLD GEODPY STICKY DISPLAY MODE.
IFN SAIL,{SAIL12:0↔SAIL16:0}
;IO OPERATIONS
EXTERN GETCHW ;GET A CHARACTER (IN CHARACTER MODE FOR TTY)
EXTERN GETCHL ;GET A CHARACTER (IN LINE MODE FOR TTY)
EXTERN GETCL0,GETCW0 ;SAME EXCEPT RETURNS RESULT IN 0 INSTEAD 1.
;WING OPERATIONS.
EXTERN MKB,MKF,MKE,MKV,MKFRAME
EXTERN KLB,KLF,KLE,KLV,WING
EXTERN WING,LINKED
EXTERN ECW,ECCW,OTHER,OTHER.
EXTERN BGET,FCW,FCCW,VCW,VCCW
;EULER OPERATIONS.
EXTERN MKEV,MKFE
INTERN CAMERA↔CAMERA:0
WORLD:0
WINDOW:0
EXTERN KLNODE,UNIVER,OLD44,AVAIL
VERNX←←14 ↔ VERNY←←11
;START ADDRESS INITIALIZATION-------------------------------------
EXTERN GEODPY
SA: JFCL↔SETOM ALONE#
SKIPE 1,OLD44↔CORE 1,↔JFCL↔SETZM OLD44 ;CORE DOWN.
SKIPA 17,PDLIOWD
GEONIT↑: SETZM ALONE
;CREATE A GEOMED UNIVERSE.
SETZM UNIVERSE
SETZM BLKCNT↑
SETZB AVAIL ;...SO THAT @AVAIL IS ZERO.
CALL(MKUNIV↑)
;SETUP STRENGTH OF TRANSFORMATION VALUES.
LAC[1.0]↔DAC TDEL ;TRANSLATION STRENGTH.
LAC[0.75]↔DAC DDEL ;DILATION STRENGTH.
LAC[0.785398]↔DAC RDEL ;ROTATION STRENGTH π/4.
SETZM FRAAM ;SELECT WORLD FRAME.
SETZM FRMORG
SETOM FLAGL ;TURN ON THE LIGHTS.
LACI 1↔DAC AXECNT ;ONE AXIS SELECT.
SETZM OPERAT ;TRANSLATION DEFAULT.
LAC[XWD -100,PADPDL]↔DAC PDLPTR
SKIPN ALONE↔POP0J
;RE-ENTRY ADDRESS INITIALIZATION----------------------------------
REE: LACI .↔DAC 124
LAC 17,PDLIOWD
OPDEF PPIOT[702B8]
OUTCHR[14]↔PGIOT 2, ;CLEAR PIECES OF GLASS
PPIOT 2,-=250↔PPIOT 3,3003
MOVEI 0,2↔MOVEM 0,DPYFLG ;TURN OFF HIDDEN LINES
PUSHJ P,[GO TRAPINIT↑]
CALL(GEODPY)
CALL(GEOMED)
EXIT
;2/4/73-----------------------------------------------------------
LIT
;ASCII 00 TO 37--------------------------------------------------
DEFINE $$(Q,A,B){XWD A,[ASCIZ"B"]}
A00: NOP ;null.
$$("↓",PADPSH,{ ↓ COPY PUSH. α↓ ROTATE PUSH.})
$$("α",{[SETOM ALPHA↔POP0J]},{α CONTROL KEY PREFIX.})
$$("β",{[SETOM BETA↔POP0J]},{β META KEY PREFIX.})
$$("∧",LINKER,{ ∧ FETCH PVT LINK})
$$("¬",XEVERT,{ ¬ BODY EVERT. α¬ BODY SUBTRACTION.})
$$("ε",{[SETOM ALPHA↔SETOM BETA↔POP0J]},{ε META-CONTROL PREFIX.})
$$("π",XRDEL,{ π ACCEPT ROTATION DELTA.})
$$("λ",XTDEL,{ λ ACCEPT TRANSLATION DELTA.})
$$(" ",NOP,{ TAB.})
$$(" ",NOP,{ LF.})
$$(" ",NOP,{ VT.})
$$(" ",NOP,{ FF.})
$$(" ",NOP,{ CR.})
$$("∞",INSTANT,{ ∞ INSTANT CUBE. α∞ INSTANT TORUS.})
$$("∂",SWCD,{ ∂ FLIP NODE DISPLAY SWITCH.})
$$("⊂",LINKER,{ ⊂ FETCH BRO LINK.})
$$("⊃",LINKER,{ ⊃ FETCH SIS LINK.})
$$("∩",LINKER,{ ∩ FETCH DAD LINK, α∩ BODY INTERSECTION.})
$$("∪",LINKER,{ ∪ FETCH SON LINK, α∪ BODY UNION.})
$$("∀",XDISBL,{ ∀ DISABLE BODY OPERATIONS SWITCH.})
$$("∃",SWC4,{ ∃ REFLECTION DEFAULT.})
$$("⊗",LINKER,{ ⊗ FETCH UNIVERSE NODE.})
$$("↔",PADSWP,{(1ST ↔ 2ND)(1ST α↔ 3RD)(1ST β↔ LAST)(2ND ε↔ 3RD)})
$$("_",XDPY,{ _ STICKY DISPLAY MODE SWITCH.})
$$("→",LINKER,{ → FETCH ALT2 LINK.})
$$("~",NOP,{ TILDE})
$$("≠",NOP,{ ≠})
$$("≤",LINKER,{ ≤ FETCH NED LINK.})
$$("≥",LINKER,{ ≥ FETCH PED LINK.})
$$("≡",SWCSD,{ TOGGLE: ≡ STATUS DISPLAY, α≡ BORDER DISPLAY.})
$$("∨",LINKER,{ ∨ FETCH NVT LINK.})
;----------------------------------------------------------------
;ASCII 40 TO 100-------------------------------------------------
$$(" ",XREDPY,{ REFRESH DISPLAY.})
$$("!",SWC1,{ ! TRANSLATION DEFAULT SWITCH.})
$$(" ",NOP,{ NOP - DOUBLE QUOTE.})
$$("#",CRLF20,{ # TWENTY CRLF'S. α# ENTER DDT.})
$$("$",XCONVEX,{ MAKE CONVEX.})
$$("%",XDDEL,{ % SET DILATION DELTA STRENGTH.})
$$("&",NOP,{ & NOP.})
$$("'",NOP,{ ' NOP.})
$$("(",EUTRAN,{ EUCLIDEAN TRANSFORMATION -Y.})
$$(" ",EUTRAN,{ EUCLIDEAN TRANSFORMATION +Y.})
$$("*",EUTRAN,{ EUCLIDEAN TRANSFORMATION +Z.})
$$("+",LINKER,{ OTHER LINK.})
$$(" ",LINKER,{ CLOCKWISE LINK.})
$$("-",EUTRAN,{ EUCLIDEAN TRANSFORMATION -Z.})
$$(".",LINKER,{ COUNTER CLOCKWISE LINK.})
$$("/",HALVE ,{ HALVE STRENGTH.})
$$("0",SETDIG,{ SET-DIGIT COMMAND.})
$$("1",SETDIG,{ SET-DIGIT COMMAND.})
$$("2",SETDIG,{ SET-DIGIT COMMAND.})
$$("3",SETDIG,{ SET-DIGIT COMMAND.})
$$("4",SETDIG,{ SET-DIGIT COMMAND.})
$$("5",SETDIG,{ SET-DIGIT COMMAND.})
$$("6",SETDIG,{ SET-DIGIT COMMAND.})
$$("7",SETDIG,{ SET-DIGIT COMMAND.})
$$("8",SETDIG,{ SET-DIGIT COMMAND.})
$$("9",SETDIG,{ SET-DIGIT COMMAND.})
$$(":",EUTRAN,{ EUCLIDEAN TRANSFORMATION +X.})
$$(";",EUTRAN,{ EUCLIDEAN TRANSFORMATION -X.})
$$("<",LINKER,{ FETCH NFACE LINK.})
$$("=",SWC3,{ DILATION DEFAULT SWITCH.})
$$(">",LINKER,{ FETCH PFACE LINK.})
$$("?",QMARK,{ INFORMATION PREFIX.})
$$("@",SWC2,{ ROTATION DEFAULT SWITCH.})
;----------------------------------------------------------------
;ASCII 101 TO 132 UPPER CASE-------------------------------------
;ASCII 141 TO 172 LOWER CASE.
A101:
$$("A",ATTDET,{ A ATTACH, αA ARROW, βAXECNT.})
$$("B",XBODY ,{ B BODY RETRIEVAL.})
$$("C",XCOPY ,{ C COPY. αC GET CAMERA.})
$$("D",ATTDET,{ D DETACH, αDARKEN, βDUAL, εUNDARKEN.})
$$("E",SWIRE ,{ E SWEEP WIRE, εE EXIT.})
$$("F",SWCF,{ F FRAME STEP SWITCH.})
$$("G",XGLUE,{ G GLUE COMMAND.})
$$("H",COMHLP,{ H HELP. αH NO HELP.})
$$("I",XIN,{ I INPUT B3D. αI CAMERA. βI CRE. εI D3D.})
$$("J",JOINVV,{ J JOIN VERTEX-VERTEX.})
$$("K",XKILL,{ K KILL COMMANDS.})
$$("L",SWCL,{ L LABEL LIGHTS SWITCH.})
$$("M",MIDPOI,{ M MIDPOINT COMMAND.})
$$("N",XNAME,{ N NAME BODY.})
$$("O",XOUT,{ O OUTPUT B3D. αO CAMERA. βO TRI FOR MAKVID. εO D3D.})
$$("P",XPLOTO,{ P OUTPUT PLOT FILE})
$$("Q",SWCQ,{ Q FRAME ORIGIN SWITCH.})
$$("R",XROTCM,{ R ROTATION COMPLETION.})
$$("S",XSWEEP,{ S SWEEP. αS PYRAMID. βS SMOOTH SWEEP. εSMOOTH PYRAMID.})
$$("T",XTEXT,{ T TEXT LABEL. αT TAKE A PICTURE. εβ TRIANGLE SWEEP.})
$$("U",NOP,{ U NOP})
$$("V",VBODY,{ V MAKE VERTEX BODY.})
$$("W",XWMAKE,{ MAKE: W WINDOW. αW WINDOW-DISPLAY. βW WORLD.})
$$("X",EXTEND,{X EXTENDED COMMANDS.})
$$("Y",NOP,{ Y NOP})
$$("Z",NEWMAC,{ Z MACRO CALL, αZ EDIT MACRO, βZ TAKE COMMANDS FROM FILE.})
;ASCII 133 TO 140.
$$("[",NOP,{ NOP})
$$("\",DOUBLE,{ \ DOUBLE STRENGTH.})
$$("]",NOP,{ NOP})
$$("↑",PADPOP,{ ↑ PADPDL POP. α↑ ROTATE POP.})
$$("←",LINKER,{ ← FETCH ALT LINK.})
$$("`",XTEST↑,{ EDGE SLURP.})
;ASCII 173 TO 177.
A173:
$$("{",XSTEP,{ STEP NOW: DISPLAY, αWORLD, βCAMERA.})
$$("|",XINVERT,{ | INVERT EDGE PARITY.})
$$(" ",XDPY,{ ALT OCCULT. αALT FRONT FACE. βALT ALL EDGES.})
$$("}",XSTEP,{ STEP NOW: DISPLAY, αWORLD, CAMERA OF β WORLD, OF ε WINDOW.})
$$(" ",NOP,{ RUBOUT})
;----------------------------------------------------------------
LIT
SUBR(VBODY) ;MAKE VERTEX BODY.
LAC PTR,PDLPTR
SETQ(BNEW,{MKB,WORLD})
PUSH PTR,1 ;BODY INTO PADPDL
SKIPE META↔GO L1 ;DISABLE FACE & VERTEX.
CALL(MKF,BNEW)↔PUSH PTR,1 ;FACE INTO PADPDL
CALL(MKV,BNEW)↔PUSH PTR,1 ;VERTEX INTO PADPDL
L1: DAC PTR,PDLPTR
SKIPE CTRL↔POP0J ;DISABLE MAKE FRAME.
CALL(MKFRAME)↔LAC 2,BNEW
FRAME. 1,2↔POP0J
DECLARE{BNEW}
ENDR VBODY;2/4/73(BGB)------------------------------------------------
SWIRE:
CDR 2,PDLPTR
IFN SAIL,{LAC 12,SAIL12↔LAC 16,SAIL16} ;COULD BE AN EXIT.
SKIPN MTCT↔GO .+4↔POP P,0
LAC 1,(2)↔POP0J ;"εE" - EXIT GEOMED.
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+2↔POP0J ;PADPDL EMPTY TEST.
CALL(LINKED,{-1(PTR)},{(PTR)}) ;LEGAL ARGS TEST.
SKIPN 1↔POP0J
LAC PTR,PDLPTR
CALL(MKEV,{-1(PTR)},{(PTR)}) ;MAKE EDGE VERTEX.
LAC PTR,PDLPTR↔DAC 1,(PTR)
POP0J
SUBR(JOINVV)
ACCUMULATORS{F,V1,V2,E1,E2}
LAC PTR,PDLPTR↔CDR 1,PTR
CAIGE 1,PADPDL+2↔POP0J ;REQUIRES TWO ARGUMENTS.
LAC V1,(PTR)
LAC V2,-1(PTR)↔DAC V2,F
TEST V1,VBIT↔POP0J ;AT LEAST ONE VERTEX.
TEST F,FBIT↔GO L1
;JOIN ENDS OF WIRE CASE.
PED E1,F↔PVT V2,E1↔DAC V2,(PTR)
CALL(MKFE,V2,F,V1)
EXIT1
;JOIN VERTICES ACROSS A FACE.
L1: TEST V2,VBIT↔POP0J
PED E1,V1↔DAC E1,E0#
L2: SETQ(F,{FCCW,E1,V1})
PED E2,V2↔DAC E2,EE0#
L3: CALL(FCCW,E2,V2)↔CAMN 1,F↔GO L4 ;FACE IN COMMON.
SETQ(E2,{ECCW,E2,V2})↔CAME E2,EE0↔GO L3
SETQ(E1,{ECCW,E1,V1})↔CAME E1,E0↔GO L2↔POP0J
L4: POP PTR,0↔DAC PTR,PDLPTR
CALL(MKFE,V1,F,V2)
EXIT2
ENDR JOINVV;2/5/73(BGB)
SUBR(MIDPOI) ;"M" MIDPOINT AN EDGE PROPORTIONAL TO DDEL.
;---------------------------------------------------------------------
CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔POP0J
LAC 1,(PTR)↔TEST 1,EBIT↔POP0J
PVT 0,1↔DAC V1
NVT 0,1↔DAC V2
CALL(ESPLIT↑,1)↔DAC 1,(PTR)
LAC 2,V1↔SLACI XWC(2)↔LAPI XWC(1)↔BLT ZWC(1)
LAC DDEL↔FMPRM XWC(1)↔FMPRM YWC(1)↔FMPRM ZWC(1)
LAC 2,V2↔SLACI 3,(1.0)↔FSBR 3,DDEL
LAC XWC(2)↔FMPR 3↔FADRM XWC(1)
LAC YWC(2)↔FMPR 3↔FADRM YWC(1)
LAC ZWC(2)↔FMPR 3↔FADRM ZWC(1)
EXIT1
DECLARE{V1,V2}
ENDR MIDPOI;2/8/73(BGB)----------------------------------------------
XINVERT: ;"|" FLIP THE FACE-VERTEX ORIENTATION OF AN EDGE.
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+1↔POP0J
LAC 1,(PTR)
TEST 1,EBIT↔POP0J
MOVSS 1(1)↔MOVSS 3(1)↔MOVSS 4(1)↔MOVSS 5(1)
POP0J
XEVERT: ;"α¬" BODY SUBTRACTION.
SKIPE CTRL↔GO XBIN ; "¬" BODY EVERT.
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+1↔POP0J
LAC 1,(PTR)↔TEST 1,BBIT↔POP0J
CALL(EVERT↑,1)
EXIT1
SUBR(EUTRAN)
COMMENT ⊗------------------------------------------------------------
Apply a Euclidean transformation to an object.
⊗
EXTERN BGET,APTRAN,MKFRAME,MKCOPY,KLNODE
EXTERN TRANSLATE,ROTATE,SHRINK
;GET TOP OBJECT OF PADPDL.
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
LAC 2,(1)↔DAC 2,OBJECT
$TYPE 0,2↔CAIN 0,$WINDOW↔GO WNTRAN
DZM DEL1↔DZM DEL2↔DZM DEL3
;OPERATION.
SKIPN 1,MCBITS↔LAC 1,OPERAT↔DAC 1,OP
LAC 2,[TRANSLATE↔ROTATE↔SHRINK↔SHRINK](1)
DAP 2,L3
;AXIS CODE.
LAC 1,CHR↔SETZ 3,
CAIE 1,";"↔CAIN 1,":"↔IORI 3,1 ;X-AXIS.
CAIE 1,"("↔CAIN 1,")"↔IORI 3,2 ;Y-AXIS.
CAIE 1,"-"↔CAIN 1,"*"↔IORI 3,4 ;Z-AXIS.
LAC 1,OP↔CAILE 1,1↔GO[ ;DILATION DELS.
SLACI(1.0)↔DAC DEL1↔DAC DEL2↔DAC DEL3
LAC AXECNT↔CAIN 2↔TRC 3,7 ;DILATION AXES.
CAIN 3↔TRO 3,7↔GO .+1]
;DELTA ARGUMENT.
LAC CHR↔LAC 1,OP
LAC 2,@[TDEL↔RDEL↔DDEL↔[-1.0]](1)
CAIN"-"↔MOVNS 2
CAIN"("↔MOVNS 2
CAIN";"↔MOVNS 2
GO@[L1↔L1↔[MOVNS 2↔JUMPGE 2,L1 ;NEGATIVE DILATION.
SLACI 2,(1.0)↔FDVR 2,DDEL↔GO L1] ;POSITIVE DILATION.
[LAC 2,[-1.0]↔GO L1]](1) ;REFLECTION DELTA.
L1: TRNE 3,1↔DAC 2,DEL1
TRNE 3,2↔DAC 2,DEL2
TRNE 3,4↔DAC 2,DEL3
;----- EUTRAN ;MAKE REFERENCE FRAME.
LAC 1,FRAAM↔GO@[[GO .+1] ;WORLD FRAME.
[CALL(BGET,OBJECT)↔GO .+1] ;BODY FRAME.
[CALL(BGET,OBJECT)↔DAD 1,1↔GO .+1] ;DADDY'S FRAME.
[LAC 1,CAMERA↔GO .+1]](1) ;CAMERA FRAME.
SKIPE 1↔FRAME 1,1
SKIPE 1↔GO[CALL(MKCOPY,1)↔GO .+1] ;COPY OF REFRAM.
DIPZ 1,REFRAM ;XWD REFRAM,0
;FRAME ORIGIN SWITCH.
SKIPN FRMORG↔GO[SKIPN OP↔GO .+1 ;NON-TRANSLATION.
CALL(BGET,OBJECT)↔FRAME 1,1
JUMPE 1,.+1↔PUSH P,1
CAR 1,REFRAM↔SKIPN 1↔CALL(MKFRAME)↔DIPZ 1,REFRAM
LAC 2,1↔POP P,1↔SLACI XWC(1)
LAPI XWC(2)↔BLT ZWC(2)↔GO .+1]
;MAKE EUCLIDEAN TRANSFORMATION MATRIX.
CALL(,REFRAM,DEL1,DEL2,DEL3)
L3: CALL(ROTATE)↔DAC 1,TRAN ;MAKE THE TRANSFORM.
SKIPE REFRAM↔GO[CAR REFRAM↔CALL(KLNODE,0)↔GO .+1];FLUSH THE REFRAM.
LAC ITERAT↔SKIPN↔AOS↔DAC COUNT
L2: CALL(APTRAN,OBJECT,TRAN)
CALL(GEODPY)
SKIPGE COUNT↔GO[
AOSL COUNT↔GO .+1
SETZM ITERAT
CALL(XSWEEP)
CDR 1,PDLPTR↔LAC(1)↔DAC OBJECT↔GO L2]
SOSLE COUNT↔GO L2
SETOM@TRAN
CALL(KLNODE,TRAN)
POP0J
DECLARE{OBJECT,TRAN,REFRAM,COUNT,OP,DEL1,DEL2,DEL3}
WNTRAN: LAC 1,CHR ;WINDOW TRANFORMATION.
CAIN 1,"-"↔GO[LAC -1(2)↔FMPR DDEL↔DAC -1(2)
SKIPE CTRL↔GO W2↔GO W1]
CAIN 1,"*"↔GO[LAC -1(2)↔FDVR DDEL↔DAC -1(2)
SKIPE CTRL↔GO W2↔GO W1]
LAC 3,TDEL↔FMPRI 3,(<100.0>)↔FIXX 3, ;TRANSLATION.
LACI 4,-2(2)↔SKIPE CTRL↔SOS 4 ;ADDRESS.
CAIN 1,";"↔GO[NIP(4)↔SUB 3↔DIP(4)↔GO W1]
CAIN 1,":"↔GO[NIP(4)↔ADD 3↔DIP(4)↔GO W1]
CAIN 1,"("↔GO[NAP(4)↔SUB 3↔DAP(4)↔GO W1]
CAIN 1,")"↔GO[NAP(4)↔ADD 3↔DAP(4)↔GO W1]
POP0J
W1: CALL(CROP↑,2)
W2: CALL(GEODPY)↔POP0J
ENDR EUTRAN;2/4/73(BGB)-----------------------------------------------
;SWITCH COMMANDS.
; ! TRANSLATION DEFAULT.
; @ ROTATION DEFAULT.
; ∃ REFLECTION DEFAULT.
; = DILATION DEFAULT.
; Q FLIP FRAME ORIGIN.
; F STEP FRAME SELECT SWITCH.
; ≡ TOGGLE STATUS DISPLAY ENABLE.
SWC1: SETZM OPERAT↔POP0J ;"!" TRANSLATION DEFAULT.
SWC2: LACI 1↔DAC OPERAT↔POP0J ;"@" ROTATION DEFAULT.
SWC3: LACI 2↔DAC OPERAT↔POP0J ;"=" DILATION DEFAULT.
SWC4: LACI 3↔DAC OPERAT↔POP0J ;"∃" REFLECTION DEFAULT.
SWCF: SKIPE CTRL↔GO XFOCAL ;"αF" SET FOCAL.
SKIPE META↔SOSA 1,FRAAM
AOS 1,FRAAM↔ANDI 1,3
DAC 1,FRAAM↔POP0J ;FRAME STEP SWITCH.
SWCL: SETCMM FLAGL↔POP0J ;"L" LABEL LIGHTS SWITCH.
SWCD: SETCMM FLAGD↔POP0J ;"∂" NODE DISPLAY SWITCH.
SWCQ: SETCMM FRMORG↔POP0J ;FRAME ORGIN TOGGLE.
SWCSD: SKIPE CTRL↔GO .+3
SETCMM FLAGSD↔POP0J ;"≡" STATUS DISPLAY TOGGLE.
LAC 1,UNIVERSE↔CW 1,1
LAC(1)↔TLC(DARKEN)↔DAC(1)↔EXIT1 ;"α≡" TOGGLE WINDOW BORDER.
CRLF20: SKIPE CTRL↔GO .+3
OUTSTR[BYTE(7)14,14]↔POP0J ;"#" TWENTY CRLF'S.
SKIPN JOBDDT↑↔GO[OUTSTR[ASCIZ/ NO DDT./]↔EXIT]
CALL(DDTGO↑)↔EXIT0 ;"α#" ENTER DDT.
XDISBL: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
LAC 1,(1)↔TEST 1,BBIT↔POP0J
LAC 2,MCBITS↔GO@[
[MARKZ 1,{BDLBIT+BDVBIT+BDPBIT}↔POP0J] ;ENABLE.
[MARK 1,BDLBIT↔POP0J] ;FRAME DISABLE
[MARK 1,BDVBIT↔POP0J] ;VERTEX DISABLE
[MARK 1,BDPBIT↔POP0J]](2) ;PARTS DISABLE
;STACK MODIFYING COMMANDS. ;"↔↓↑"
;"↔" PADPDL SWAP: PADPDL[1]↔PADPDL[2].
;"α↔" PADPDL SWAP: PADPDL[1]↔PADPDL[3].
;"β↔" PADPDL SWAP: PADPDL[2]↔PADPDL[3].
;"ε↔" PADPDL SWAP: PADPDL[1]↔PADPDL[N].
PADSWP: LAC PTR,PDLPTR↔CDR PTR
LACM 1,CTRL↔CAIGE PADPDL+2(1)↔POP0J ;ARG ∃ TEST.
LAC 1,MCBITS↔GO@[
[LAC(PTR)↔EXCH -1(PTR)↔DAC(PTR)↔POP0J] ; 1ST & 2ND.
[LAC(PTR)↔EXCH -2(PTR)↔DAC(PTR)↔POP0J] ;α 1ST & 3RD.
[LAC(PTR)↔EXCH PADPDL+1↔DAC(PTR)↔POP0J] ;β 1ST & LAST.
[LAC -1(PTR)↔EXCH -2(PTR)
DAC -1(PTR)↔POP0J] ;ε 2ND & 3RD.
](1)↔LIT
;"↓" PADPDL COPY PUSH DOWN.
;"↓" PADPDL ROTATE DOWN.
PADPSH: LAC PTR,PDLPTR↔CDR PTR
CAIGE PADPDL+1↔POP0J
SKIPE CTRL↔GO .+4
PUSH PTR,(PTR)↔DAC PTR,PDLPTR↔POP0J ;COPY PUSH.
LAC[XWD PADPDL+1,PADPDL]↔BLT -1(PTR)
LAC PADPDL↔DAC(PTR)↔POP0J ;ROTATE PUSH.
;"↑" PADPDL POP UP.
;"α↑" PADPDL ROTATE UP.
PADPOP: LAC PTR,PDLPTR↔CDR PTR
CAIGE PADPDL+1↔POP0J
SKIPE CTRL↔GO .+4
POP PTR,↔DAC PTR,PDLPTR↔POP0J ;PAD POP.
SUBI PADPDL↔POP PTR,1(PTR)↔SOJG .-1 ;ROTATE POP
LAC PTR,PDLPTR↔LAC 1(PTR)↔DAC PADPDL+1
POP0J
;STRENGTH COMMANDS.
;"/" COMMAND.-----------------------------------------------------
HALVE: SKIPN 1,MCBITS↔LAC 1,OPERAT ;EUCLIDEAN OPERATION.
LAC TDEL(1)↔FSC -1↔DAC TDEL(1) ;"/" COMMAND.
POP0J
;"\" COMMAND.-----------------------------------------------------
DOUBLE: SKIPN 1,MCBITS↔LAC 1,OPERAT ;EUCLIDEAN OPERATION.
LAC TDEL(1)↔FSC 1↔DAC TDEL(1) ;"\" COMMAND.
POP0J
;"0123456789" COMMANDS.-------------------------------------------
SETDIG: LAC 1,CHR↔ANDI 1,17 ;DIGIT.
SKIPN 2,MCBITS↔LAC 2,OPERAT ;EUCLIDEAN OPERATION.
GO@[
[LAC ITERAT↔IMULI 12↔ADD 1 ;ITERATION COUNT.
CAILE=128↔LACI=128
DAC ITERAT↔POP0J]
[SUBI 1,=10↔LAC[3.1415927] ;ROTATION DELTA.
FSC(1)↔DAC RDEL↔POP0J]
[SKIPN 1↔LACI 1,1↔FLOAT 1, ;DILATION DELTA.
FMPR 1,[0.1]↔DAC 1,DDEL↔POP0J]
[SUBI 1,4↔SLACI(1.0)↔FSC(1) ;TRANSLATION DELTA.
DAC TDEL↔POP0J]](2)
;-----------------------------------------------------------------
EXTERNAL REALI
REALIN: GO REALI
XTDEL: CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔DAC TDEL↔POP0J
XDDEL: CALL(REALIN)↔FMPR[0.01]↔DAC DDEL↔POP0J
XRDEL: CALL(REALIN)↔CAIN 1,"/"↔GO[
SKIPN↔SLACI(1.0)↔DAC RDEL ;NUMERATOR.
CALL(REALIN)↔SKIPN↔SLACI(1.0) ;DENOMINATOR.
LAC 1,RDEL↔FMPR 1,[3.1415927]
FDVR 1,0↔DAC 1,RDEL↔POP0J] ;PI FRACTION.
CAIN 1,"'"↔FMPR[1.74532925E-2] ;DEGREES.
DAC RDEL↔POP0J ;RADIANS.
;COMMAND XFOCAL
XFOCAL:
OUTSTR[ASCIZ/ FOCAL = /]↔CALL(REALIN)
JUMPE 0,[OUTSTR[ASCIZ/???
*/]↔POP0J] ;Reject zero focal length
LAC 1,UNIVERSE↔NWRLD 1,1↔NCAMR 1,1
MOVSI 2,(NOTPER)
JUMPL 0,[MOVN 0,0↔ORM 2,(1)↔GO XFOCA1] ;Negative focal length
ANDCAM 2,(1) ;turns off perspective
XFOCA1: FMPR[3.2808E-3]↔HLLM 0,3(1)
HLLZ 2,1(1)↔CDR 3,1(1)↔FLOAT 3,↔FMPR 3,0↔FDVR 3,2↔DACN 3,-3(1)
HLLZ 2,2(1)↔CDR 3,2(1)↔FLOAT 3,↔FMPR 3,0↔FDVR 3,2↔DACN 3,-2(1)
FMPR[100000.0]↔DAC 0,-1(1)↔OUTSTR[ASCIZ/*/]↔EXIT1
SUBR(XSWEEP)
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN SWEEP,PYRAMID
CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔POP0J ;ARG EXISTS.
LAC 1,(PTR)↔TESTZ 1,FBIT↔GO L2
TEST 1,VBIT↔POP0J
PED 2,1↔JUMPE 2,.+4
MOVS 0,1(2)↔CAME 0,1(2)↔GO [ SETOM CTRL↔GO L2A ]
CALL(SWIRE)↔GO L3 ;SWEEP WIRE.
COMMENT ⊗
L2: SKIPE MTCT↔GO[L2A:
CALL(PYRAMID,1)↔DAC 1,(PTR)
CALL(GEODPY)↔POP0J]
SKIPN 2,META↔LACM 2,CTRL ;0=PRISM ;α+1=CCW ;β-1=CW.
CALL(SWEEP,1,2)
⊗;
L2: LAC CHR↔CAIN "T"
GO [ SKIPL 2,CTRL
LACI 2,1
GO L2B ]
L2A: SETZ 2,
SKIPE META↔HRLI 2,-1
SKIPE CTRL
GO [ CALL(PYRAMIND,1)↔DAC 1,(PTR)
CALL(GEODPY)↔POP0J ]
L2B: CALL(SWEEP,1,2)
L3: MOVNS ITERAT↔EXIT1
ENDR XSWEEP;2/10/73(BGB)---------------------------------------------
XROTCM:
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+1↔POP0J
LAC 1,(PTR)↔TEST 1,FBIT↔POP0J
CALL(ROTCOM↑,1)
EXIT1
;--------------------------------------------------------------------
XGLUE: LAC PTR,PDLPTR↔CDR PTR↔CAIGE PADPDL+2↔POP0J ;TWO ARGS.
LAC 1,(PTR)↔LAC 2,-1(PTR)
CALL(GLUE↑,1,2)↔DAC 1,-1(PTR)
POP PTR,0↔DAC PTR,PDLPTR
EXIT1
;____________________________________________________________________
SUBR XKILL ;"K"
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN KLEV,KLVE,KLFE,REMOVF,KLBFEV
LAC PTR,PDLPTR↔CDR PTR↔CAIGE PADPDL+1↔POP0J ;ONE ARG.
LAC 1,(PTR)
TEST 1,VBIT↔GO L2
DAC 1,2↔PED 3,1↔JUMPE 3,L4
SETQ(4,{ECCW,3,2})
SETQ(5,{ECCW,4,2})
DAC 2,1↔CAME 3,5↔GO L1
CALL(KLEV,1)↔GO L3
L1: CALL(KLEV,1)↔CALL(KLFE,1)↔GO L3
L2: TESTZ 1,EBIT↔GO[SKIPE CTRL↔GO[
CALL(KLVE,1)↔GO L3]
CALL(KLFE,1)↔GO L3]
TESTZ 1,FBIT↔GO[CALL(REMOVF,1)↔GO L3]
TESTZ 1,BBIT↔GO[L4: CALL(KLBFEV,1)↔POP PTR,0
DAC PTR,PDLPTR↔CALL(GEODPY)↔POP0J]
POP0J
L3: DAC 1,(PTR)
CALL(GEODPY)
POP0J
ENDR XKILL;2/10/73(BGB)-------------------------------------------------
SUBR LINKER ;LINK FOLLOWING COMANDS.
COMMENT ⊗------------------------------------------------------------
⊗↔ LAC PTR,PDLPTR
LAC CHR↔CAIN"⊗"↔GO[PUSH PTR,UNIVERSE↔DAC PTR,PDLPTR↔POP0J]
CDR 1,PTR↔CAIGE 1,PADPDL+1↔POP0J ;STACK EMPTY.
LAC 2,(1)↔LAC CHR
CAIE"."↔CAIN","↔GO L1 ;CLOCK LINK COMMANDS.
CAIN"+"↔GO L1 ;OTHER LINK COMMAND.
CAIN"∩"↔GO[SKIPE CTRL↔GO XBIN↔DAD 2,2↔GO L0]
CAIN"∪"↔GO[SKIPE CTRL↔GO XBIN↔SON 2,2↔GO L0]
CAIN"⊂"↔GO[BRO 2,2↔GO L0]
CAIN"⊃"↔GO[SIS 2,2↔GO L0]
CAIE "<"↔CAIN ">"↔ADDI 2,1
CAIE "≤"↔CAIN "≥"↔ADDI 2,2
CAIE "∨"↔CAIN "∧"↔ADDI 2,3
CAIE "←"↔CAIN "→"↔GO[ADDI 2,6↔SKIPN MCBITS↔GO .+1↔GO L6]
SKIPE CTRL↔SUBI 2,4 ;-3 -2 -1
SKIPE META↔ADDI 2,5 ;6 7 8
SKIPE MTCT↔ADDI 2,2 ;4 5 6
LAC 2,(2) ;FETCH WORD FROM THE NODE.
CAIN "≤"↔MOVSS 2
CAIN "<"↔MOVSS 2
CAIN "∨"↔MOVSS 2
CAIN "←"↔MOVSS 2
L0: CDR 2
CAML 44↔GO .+3 ;LOWER THAN MAX.
CAML UNIVER↔DAC(1) ;HIGHER THAN MIN.
POP0J
;----- LINKER ;OTHER LINK COMMANDS.
L1: CAME 2,UNIVERSE↔TESTZ 2,PBIT↔GO[LAC CHR ;OBJECT CLOCK LINKS.
CAIN"."↔GO[CCW 2,2↔DAC 2,(1)↔POP0J] ;CCW BODY.
CAIN","↔GO[ CW 2,2↔DAC 2,(1)↔POP0J] ; CW BODY.
POP0J]
ANDI 0,17 ;GET TYPE NUMBER
CAIN 0,$TEXT
GO [LAC CHR ;SPECIAL HACK FOR TEXT LIST
CAIN"."↔GO[TCCW 2,2↔SKIPE 2↔DAC 2,(1)↔POP0J] ;CCW TEXT
CAIN","↔GO[ TCW 2,2↔DAC 2,(1)↔POP0J] ; CW BODY.
POP0J]
CAIGE 1,PADPDL+2↔POP0J ;TWO ARGUMENTS REQUIRED.
LAC 1,0(PTR)↔LAC 2,-1(PTR)
CALL(LINKED,1,2)↔SKIPN 1↔POP0J ;WHICH ARE LINKED.
LAC 1,0(PTR)↔LAC 2,-1(PTR)
SETZ 3,↔LAC CHR
CAIN"+"↔GO L2
CAIE","↔AOS 3 ;DISTINGUISH CW & CCW.
SKIPN CTRL↔ADDI 3,2
SKIPE CTRL↔ADDI 3,4 ;DISTINGUISH OPERATION.
;EDGE IS IN THE FIRST POSITION OF THE STACK.
L2: TEST 1,EBIT↔GO L3 ;EDGE.
TEST 2,FBIT↔GO[TEST 2,VBIT↔POP0J ;FACE OR VERTEX.
SKIPE CTRL↔ADDI 3,2↔GO .+1] ;CTRL VERTEX.
PUSH P,1↔PUSH P,2↔PUSHJ P,@L5(3)
CAIN 3,2↔AOS PTR↔CAIN 3,3↔AOS PTR
DAC 1,-1(PTR)↔POP0J
;EDGE IS IN THE SECOND POSITION OF THE STACK.
L3: TEST 2,EBIT↔POP0J
TEST 1,FBIT↔GO[TEST 1,VBIT↔POP0J
SKIPE CTRL↔ADDI 3,2↔GO .+1]
PUSH P,2↔PUSH P,1↔PUSHJ P,@L5(3)
CAIN 3,2↔SOS PTR↔CAIN 3,3↔SOS PTR
DAC 1,0(PTR)↔POP0J
L5: OTHER↔OTHER↔ECW↔ECCW↔VCW↔VCCW↔FCW↔FCCW
;STEP ALONG IMAGE RINGS OF THE "NOW" CAMERA.
L6: LAC 1,UNIVERSE
NWRLD 1,1↔NCAMR 1,1
SKIPE CTRL↔GO L7
PIMAG 2,1↔SKIPN 2↔POP0J↔PTIME 3,2↔CAIE"→"↔NTIME 3,2↔PIMAG. 3,1
CALL(GEODPY)↔POP0J
L7: SIMAG 2,1↔SKIPN 2↔POP0J↔PTIME 3,2↔CAIE"→"↔NTIME 3,2↔SIMAG. 3,1
CALL(GEODPY)↔POP0J
ENDR LINKER;2/9/73(BGB)----------------------------------------------
;COMMANDS XNAME,XBODY ;"B","N"
SUBR(XNAME) ;NAME A BODY
COMMENT ⊗------------------------------------------------------------
⊗↔ CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
LAC 1,(1)↔TEST 1,BBIT↔POP0J
CALL(RDNAME)
JUMPE 6,[ OUTSTR[ASCIZ/ILLEGAL NAME.
*/]↔ POP0J]
CALL(FNDNAME)
GO [ LAC 1,PDLPTR↔LAC 1,(1)
DAC 4,-2(1)↔DAC 5,-1(1)
OUTSTR[ASCIZ/*/]↔POP0J ]
OUTSTR[ASCIZ/NAME ALREADY IN USE.
*/]↔ POP0J
ENDR XNAME;2/9/73(BGB)-----------------------------------------------
SUBR(XBODY) ;BODY RETRIEVAL.
COMMENT ⊗------------------------------------------------------------
⊗↔ LAC PTR,PDLPTR
SKIPN CTRL↔GO[CDR 1,PTR↔CAIGE 1,PADPDL+1↔GO .+1
CALL(BGET,{(PTR)})↔DAC 1,(PTR)↔POP0J]
CALL(RDNAME)↔JUMPN 6,L2
;FETCH BODY BY ITS SERIAL NUMBER.
LAC 1,UNIVERSE↔NWRLD 1,1 ;GET NOW WORLD.
DAC 1,WORLD↔CCW 1,1
CAME 1,WORLD↔SOJG 3,.-2
CAME 1,WORLD↔GO RET
LOSE: OUTSTR[ASCIZ/BODY NOT FOUND.
*/]↔ POP0J
;FETCH BODY BY ITS PNAME.
L2: CALL(FNDNAME)↔GO LOSE
RET: PUSH PTR,1
DAC PTR,PDLPTR
OUTSTR[ASCIZ/*/]↔POP0J
ENDR XBODY;2/9/73(BGB)-----------------------------------------------
SUBR RDNAME
COMMENT ⊗------------------------------------------------------------
⊗↔ OUTSTR[ASCIZ/ :/]
LACI 2,=10 ;TEN CHARACTERS TO A NAME.
LAC 1,[POINT 7,4,-1]
SETZB 3,6 ;BODY SERIAL NUMBER.
SETZB 4,5
L: CALL(GETCL0)↔CAIN 15↔GO EOL ;END OF LINE.
IDPB 1↔CAIGE"0"↔GO .+3↔CAIG"9"↔GO[
IMULI 3,12↔ANDI 0,17↔ADD 3,0↔GO .+2]
SETOM 6 ;NON-NUMERIC CHR SEEN.
SOJG 2,L
CALL(GETCL0)↔CAIE 15↔GO .-2
CRLF
SKIPA
EOL: CALL(GETCL0)↔POP0J
ENDR RDNAME;(TVR)----------------------------------------------------
SUBR FNDNAME ;FETCH BODY BY ITS PNAME.
COMMENT ⊗------------------------------------------------------------
⊗
LAC 1,UNIVERSE↔NWRLD 1,1↔DAC 1,WORLD ;GET "NOW" WORLD.
L1: CCW 1,1↔CAMN 1,WORLD↔POP0J ;SCAN THE BODIES.
CAME 4,-2(1)↔GO L1↔CAME 5,-1(1)↔GO L1 ;COMPARE THE NAMES.
AOS(P)↔POP0J
ENDR FNDNAME;2/9/73(BGB)---------------------------------------------
SUBR(INSTANT)
OPDEF PTO[711440B17]
LAC 1,MCBITS
PTO @[[0↔MACRO0]
[0↔MACRO1]
[0↔MACRO2]
[0↔MACRO3]] (1)
POP0J
MACRO0: ASCIZ"V\:)\E;E(E:J↑/*S--↑/@/:)\!"
MACRO1: ASCIZ"V:7@S*J!↑8/:\@S)↓>G↑:)!"
MACRO2: ASCIZ"⊗αW↔∪A⊃⊃↔βWA↑βAβAβ/β-λ256
):↔β-);//β\β*(↔β*(λ.25
⊃:↔⊂;\\↑↑βA"
MACRO3: 0
ENDR INSTANT;2/9/73(BGB)---------------------------------------------
SUBR(ATTDET) ;ATTACH-DETACH COMMANDS & FRIENDS.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN BDET,BATT,FVDUAL
LAC 1,CHR
CAIE 1,"D"↔GO L4
;DETACH, αDARKEN, βDUAL, εUNDARKEN.
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J ;DETACH.
LAC 1,(1)↔TEST 1,BBIT↔GO L3
SKIPE META↔GO[CALL(FVDUAL,1)↔CALL(GEODPY)↔POP0J]
CALL(BDET,1)↔POP0J
L3: TEST 1,EBIT↔POP0J
SLACI 0,(DARKEN)↔IORM(1)↔SKIPE META↔ANDCAM(1)
EXIT1
;ATTACH, αNOP, βAXECNT.
L4: SKIPE CTRL↔GO XARROW
SKIPE META↔GO[AOS 1,AXECNT ;STEP AXECNT.
CAIL 1,4↔LACI 1,1↔DAC 1,AXECNT
POP0J]
CDR 1,PDLPTR↔CAIGE 1,PADPDL+2↔POP0J ;ATTACH.
LAC 2,-1(1)↔LAC 1,(1)
CALL(BATT,1,2)↔POP0J
ENDR ATTDET;2/9/73(BGB)----------------------------------------------
XDPY:
LAC 1,CHR
CAIN 1,"_"↔GO[LAC MCBITS↔DAC DPYFLG↔CALL(GEODPY)↔POP0J]
CAIE 1,175↔POP0J
LAC MCBITS↔PUSH P,DPYFLG↔DAC DPYFLG↔DAC ODPYFLG
CALL(GEODPY)↔POP P,DPYFLG↔POP0J
XCOPY:
BEGIN XCOPY
;βC - MAKE CAMERA IN NOW WORLD.
SKIPE META↔GO[
LAC 1,UNIVERSE↔NWRLD 1,1↔CALL(MKCAMERA↑,1)↔EXIT2]
;βC - FETCH CAMERA IN NOW WORLD.
SKIPE CTRL↔GO[LAC 1,UNIVERSE↔NWRLD 1,1↔NCAMR 1,1↔EXIT2]
; C - COPY.
LAC 16,PDLPTR↔CDR 1,16
CAIGE 1,PADPDL+1↔POP0J
CALL(MKCOPY↑,{(1)})
LACI 2↔DAC DPYFLG↔EXIT2 ;DON'T OCCULT.
LIT
BEND XCOPY
XIN:
EXTERN ICAM,INCRE ;INPUT FORMAT TYPE-1.
SKIPE CTRL↔GO[SKIPE META
GO [ CALL(IND3D↑)↔CALL(GEODPY)↔POP0J] ;εI D3D.
CALL(ICAM)↔CALL(GEODPY)↔POP0J] ;αI CAM.
SKIPE META↔GO[CALL(INCRE)↔CALL(GEODPY)↔POP0J] ;βI CRE.
CALL(INB3D↑)↔SKIPN 1↔POP0J ; I B3D.
EXIT2
LIT
XOUT:
EXTERN OCAM,OFORM2
SKIPE CTRL↔GO[SKIPE META
GO[CALL(OUTD3D↑)↔POP0J] ; εO D3D.
CALL(OCAM)↔POP0J] ; αO CAM.
SKIPE META↔GO[CALL(OFORM2)↔POP0J] ; βO TRI.
CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
CALL(OUTB3D↑,{(1)}) ; O B3D.
POP0J
LIT
COMHLP: ;HELP COMMAND.
SKIPN CTRL↔GO .+4
SETZB 0,1 ;"αH" CLEAR HELP DISPLAY.
UPGIOT 16,0↔POP0J
CALL(TVHELP↑,[[SIXBIT/GEOMEDDOC/↔0↔SIXBIT/DOCBGB/]])
POP0J
XBIN:
EXTERN BIN,BUN,BSUB,KLBFEV,MKCVEX
CDR 1,PDLPTR↔CAIGE 1,PADPDL+2↔POP0J
LAC 2,-1(1)↔LAC 1,(1)↔LAC CHR
CAIN"∩"↔GO[CALL(BIN,2,1)↔GO .+5] ;INTERSECTION.
CAIN"∪"↔GO[CALL(BUN,2,1)↔GO .+3] ;UNION.
CAIN"¬"↔GO[CALL(BSUB,2,1)↔GO .+1] ;SUBTRACTION.
PUSH P,1
CALL(GEODPY)↔CALL(MKCVEX,{(P)})
LAC 1,PDLPTR↔POP 1,2↔DAC 1,PDLPTR
CALL(KLBFEV,2)↔CDR 1,PDLPTR↔LAC 2,(1)↔POP P,(1)
CALL(KLBFEV,2)
EXIT1
LIT
; W - MAKE WINDOW IN "NOW" DISPLAY RING.
;αW - MAKE WINDOW IN A NEW DISPLAY RING.
;βW - MAKE WORLD AT END OF WORLD RING.
XWMAKE:
BEGIN XWMAKE
SKIPE META↔GO[CALL(MKWORLD↑)↔EXIT2]
LAC 1,UNIVERSE↔CW 2,1 ;"NOW" DISPLAY.
NWRLD 1,1↔NCAMR 1,1 ;"NOW" CAMERA.
SKIPE CTRL↔ZAC 2, ;NEW DISPLAY DESIRED.
CALL(MKWINDOW↑,1,2)
EXIT2
LIT
BEND XWMAKE
XPLOTO: CALL(PLOTO↑)↔OUTCHR["*"]↔POP0J
; { } STEP NOW DISPLAY.
;α{ } STEP NOW WORLD.
;β{ } STEP NOW CAMERA OF THE NOW WORLD.
;ε{ } STEP NOW CAMERA OF THE NOW DISPLAY.
XSTEP:
BEGIN XSTEP
LAC 1,UNIVERSE
SKIPE META↔GO L1
SKIPE CTRL↔GO L2
CW 2,1↔ CAIN"}"↔CCW 2,2↔CAIN"{"↔CW 2,2↔CW. 2,1
EXIT1
L1: SKIPE CTRL↔CW 1,1 ;NOW DISPLAY.
SKIPN CTRL↔NWRLD 1,1 ;NOW WORLD.
NCAMR 2,1↔JUMPE 2,[POP0J]
CAIN"}"↔SIS 2,2↔CAIN"{"↔BRO 2,2↔NCAMR. 2,1↔EXIT1
L2: NWRLD 2,1↔JUMPE 2,[POP0J]
CAIN"}"↔SIS 2,2↔CAIN"{"↔BRO 2,2↔NWRLD. 2,1↔EXIT1
LIT
BEND XSTEP
LIT
SUBR(NEWMAC)
EXTERNAL MACPTR,MACCNT,MACNOD,IFORM2
↑NEWMAC:SKIPE META
JCALL IFORM2
SKIPN CTRL
GO [ CALL(RDNAME)
CALL(FNDNAM) ;Is there a macro by that name?
GO [ OUTSTR[ASCIZ/NO SUCH MACRO
*/] ;No, return
POP0J ]
PVT 1,1 ;Get vertex of body
JUMPE 1,[FATAL(BODY WITHOUT VERTEX!)] ;Nothing there!
PY 1,1
JUMPE 1,[NOTMAC: OUTSTR[ASCIZ/NOT A MACRO.
*/]↔ POP0J]
LAC 0,(1)↔ANDI 0,17
CAIE 0,$YNODE↔GO NOTMAC
YCODE 0,1↔CAIE 0,$TEXTHD↔GO NOTMAC
PTEXT 1,1 ;Text of vertex
JUMPE 1,NOTMAC↔OUTSTR[ASCIZ/<ENTERING MACRO>
/]↔ DAC 1,MACNOD
HRLI 1,000700↔DAC 1,MACPTR ;BYTE POINTER.
MOVEI 0,5*8-1↔DAC 0,MACCNT ;COUNT.
POP0J ] ;Now, return
CALL(RDNAME)
CALL(FNDNAM)
SKIPA
GO [ OUTSTR[ASCIZ/Name already in use/]
PVT 1,1 ;Get vertex of body
PTEXT 0,1
JUMPN 0,[ OUTSTR[ASCIZ/. Will edit.
/]↔ CALL(EDTEXT↑,1)
POP0J ]
OUTSTR[ASCIZ/ and not a macro.
*/]↔ POP0J ]
PUSHP 4↔PUSHP 5 ;Save print name
SETQ(BNEW,{MKB,WORLD}) ;Make a new body
POPP -1(1)↔POPP -2(1) ;Set print name
CALL(MKV,BNEW) ;Make a vertex
EDIT: CALL(EDTEXT,1) ;Put text on it
POP0J
DECLARE{BNEW}
ENDR NEWMAC;(TVR)----------------------------------------------------
XTEXT: ;TEXT COMMAND.
SKIPE CTRL↔GO XTAKE ;SIMULATED TAKE-A-PICTURE.
SKIPE META↔GO XSWEEP ;TRIANGULAR SWEEP
CDR 1,PDLPTR ;GET PDL POINTER
CAIGE 1,PADPDL+1↔POP0J ;IS THERE ANYTHING?, IF NOT RETURN
LAC 2,(1) ;GET ARG OFF PDL
TEST 2,VBIT↔POP0J ;MUST BE A VERTEX.
CALL(EDTEXT,2)
JCALL GEODPY
XTAKE: ;MAKE A SYNTHETIC PICTURE.
LAC 1,UNIVERSE
NWRLD 1,1
NCAMR 1,1
CALL(TAKE↑,1) ;CAMERA ARGUMENT.
EXIT1
XCONVEX: ;FORCE CONVEX FACES.
CDR 1,PDLPTR
CAIGE 1,PADPDL+1↔POP0J
LAC(1)
CALL(MKCVEX↑,0)
EXIT1
XREDPY: ;REDISPLAY.
CALL(STADPY)
PUSH P,DPYFLG
LAC ODPYFLG
DAC DPYFLG
CALL(GEODPY)
POP P,DPYFLG
POP0J
SUBR(EXTEND) ;"X"-EXTEND COMMANDS.
COMMENT ⊗------------------------------------------------------------
⊗
OUTSTR[ASCIZ/ COMMAND? /]
LAC 1,[POINT 6,3,17] ;SIXBIT CHARACTER TO AC3.
LACI 2,3↔ZAC 3, ;THREE CHARACTERS EXPECTED.
L1: CALL(GETCL0)
CAIE 40↔CAIN 175↔GO L2 ;TEST FOR END OF COMMAND NAME.
CAIN 15↔GO[CALL(GETCL0)↔GO L2]
CAIN "("↔JUMPG 3,L1 ;IGNORE EARLY LEFT PARENS.
CAIN "("↔GO L2
CAIL"a"↔SUBI 40 ;SUPRESS LOWER CASE.
SOJL 2,L1 ;SUPRESS EXCESS LETTERS.
SUBI 40↔IDPB 1↔GO L1 ;PACK CHARACTER INTO AC3.
;SCAN EXTENDED COMMAND JUMP TABLE FOR A MATCH.
L2: LACI 1,BEGXJT↔CDR 2,(1)
CAMN 3,2↔GO[CAR(1)↔GO@]
CAIE 1,ENDXJT↔AOJA 1,L2+1
OUTSTR[ASCIZ/ --- NO SUCH COMMAND.
*/]↔ POP0J
ENDR EXTEND;7/19/73(BGB)---------------------------------------------
;EXTENDED COMMAND JUMP TABLE.
BEGXJT: XWD XCUBE,'CUB' ;MAKE CUBIC PRISM.
XWD XCYLN,'CYL' ;MAKE CYLINDER.
XWD XBALL,'BAL' ;MAKE SPHERE.
XWD XCOLOR,'COL' ;COLORING.
XWD XNSHAR,'NSH' ;EDGES NOT SHARP.
XWD XSCROL,'SCR' ;SCROLL THE CAMERA'S VISIBLE EDGES.
XWD XIGEM,'IGE' ;INPUT GEM FILE.
XWD XOGEM,'OGE' ;OUTPUT GEM FILE.
ENDXJT: XWD [POP0J],0 ;EMPTY COMMAND.
;EXTEND COMMAND EXECUTIONS.
XCUBE: ;MAKE CUBIC PRISM. "X-CUB".
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;DELTA-X
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;DELTA-Y
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;DELTA-Z
CALL(MKCUBE↑)
XXIT: EXIT2
XCYLN:
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;RADIUS.
CALL(REALIN)↔PUSH P, ;N SIDES.
CALL(REALIN)↔PUSH P,↔CALL(MKCYLN↑) ;HEIGHT.
JCALL XXIT
XBALL:
CALL(REALIN)↔CAIN 1,42↔FDVR[12.0]↔PUSH P,0 ;RADIUS.
CALL(REALIN)↔PUSH P,
CALL(REALIN)↔PUSH P,↔CALL(MKBALL↑)
JCALL XXIT
XNSHARP: ;MARK ALL EDGES NOT-SHARP.
BEGIN NSHARP;--------------------------------------------------------
ACCUMULATORS{B,E}
;GET ARGUMENT FROM TOP OF STACK.
CDR PTR,PDLPTR↔CAIGE PTR,PADPDL+1↔POP0J
LAC B,(PTR)↔LAC E,B
TEST E,EBIT↔PED E,B ;EDGE OR FIRST EDGE.
L1: TEST E,EBIT↔EXIT0 ;NOT AN EDGE.
MARK E,NSHARP
PED E,E↔GO L1
BEND NSHARP;8/7/73(BGB)----------------------------------------------
XIGEM: CALL(IGEM2↑)↔SKIPN 1↔POP0J↔EXIT2
XOGEM: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔POP0J
CALL(OGEM2↑,{(1)})↔EXIT0
SUBR(XSCROL) ;SCROLL CAMERA VISIBLE EDGES.
ACCUMULATORS{W,X,Y,Z,D}
LAC 1,UNIVERSE↔CW 1,1↔DAC 1,WINDOW
LACI 1,=64↔DAC 1,DELTA
CALL(SHOW2↑,WINDOW,[-1]) ;OCCULT - BUT NO KLTEMPS.
OUTSTR[ASCIZ/ #/]
CALL(GETCHW)↔CAIN 1,12 ;SUPPRESS EXTRA LF.
L1: CALL(GETCHW)
CAIE 1,15↔CAIN 1,12↔GO L2
LAC W,WINDOW
NIP X,-3(W)↔NAP Y,-3(W)
LAC Z,-1(W)↔LAC D,DELTA
CAIN 1,"/"↔ASH D,-1↔CAIN 1,"\"↔ASH D,1
CAIN 1,":"↔ADD X,D↔CAIN 1,";"↔SUB X,D
CAIN 1,")"↔ADD Y,D↔CAIN 1,"("↔SUB Y,D
CAIN 1,"*"↔FMP Z,[1.2]↔CAIN 1,"-"↔FMP Z,[0.833334]
DIP X,-3(W)↔DAP Y,-3(W)
DAC Z,-1(W)↔SKIPE D↔DAC D,DELTA
CALL(CROP↑,WINDOW)
CALL(CLIPER↑,WINDOW)
CALL(IIIDPY↑,WINDOW,[1])
GO L1
L2:
LAC W,WINDOW
LAC[3.5]↔DAC -1(W)
SETZM -3(W)
NCAMR 1,W↔PWRLD 1,1
CALL(KLTMPS↑,1) ;KLTEMPS.
POP0J
DECLARE{WINDOW,DELTA}
ENDR XSCROL;8/12/73(BGB)---------------------------------------------
SUBR(XCOLOR) ;COLORING X-COMMAND.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,F,W4,W5}
;GET ARGUMENT FROM TOP OF STACK.
CDR PTR,PDLPTR
CAIGE PTR,PADPDL+1↔POP0J
LAC B,(PTR)↔LAC F,B
TEST F,FBIT↔PFACE F,B ;FACE OR FIRST FACE.
TEST F,FBIT↔POP0J↔PUSHP F↔PUSHP B
;OLDE AND NEW VALUES.
LAC 4(F)↔DAC WORD4
LAC 5(F)↔DAC WORD5
DOM ALBEDO↔DOM RED
DOM GRN↔DOM BLU↔GO L1B
;DECODE COLORING ARGUMENTS. 00R 00B 00G 00A
L1: CALL(GETCL0)
CAIE 15↔CAIN 12↔GO L2
L1B: CALL(REALIN)
CAIN 1,"A"↔DACM ALBEDO
CAIN 1,"R"↔DACM RED
CAIN 1,"G"↔DACM GRN
CAIN 1,"B"↔DACM BLU
CAIE 1,15↔GO L1
;SETUP NEW PHOTOMETRIC PARAMETERS.
L2: SKIPGE 1,ALBEDO↔GO L2R ;ALBEDO.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔LACI 1,777
DPB 1,[POINT 9,WORD4,35]
L2R: SKIPGE 1,RED↔GO L2G ;RED.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔LACI 1,777
DPB 1,[POINT 9,WORD4,8]
L2G: SKIPGE 1,GRN↔GO L2B ;GREEN.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔LACI 1,777
DPB 1,[POINT 9,WORD4,17]
L2B: SKIPGE 1,BLU↔GO L3 ;BLUE.
FMP 1,[0.01]↔FIX 1,222000
CAILE 1,777↔LACI 1,777
DPB 1,[POINT 9,WORD4,26]
L3: LAC W4,WORD4↔LAC W5,WORD5↔POPP B↔POPP F
L4: DAC W4,4(F)↔DAC W5,5(F)
CAMN B,F↔POP0J↔PFACE F,F
CAMN B,F↔POP0J↔GO L4
DECLARE{ALBEDO,RED,GRN,BLU,WORD4,WORD5}
ENDR XCOLOR;7/20/73(BGB)---------------------------------------------
SUBR(XARROW)
ACCUMULATORS{E1,V1,V2,Y1,Y2}
CDR 1,PDLPTR
CAIGE 1,PADPDL+1↔POP0J
SETZM FOOFLG
LAC E1,(1)
MOVEI 17
AND (E1)
CAIN $EDGE
GO DOEDGE
CAIN $YNODE
GO [ YCODE 0,E1
CAIE $ARROW
POP0J
LAC Y1,E1
PARRW Y2,Y1
LDB 0,[POINT 3,(Y1),12]
GO L2 ]
CAIN $VERT
GO [ LAC V1,E1
CAIGE 1,PADPDL+2↔GO YSV1
LAC V2,-1(1)
MOVEI 17
AND (V2)
CAIE $VERT
GO YSV1
CAIGE 1,PADPDL+3↔POP0J
LAC E1,-2(1)
MOVEI 17
AND (E1)
CAIE $EDGE
GO YSV2
GO DOVERT ]
POP0J
DOEDGE: PVT V1,E1
NVT V2,E1
CALL YSRCH2
GO DOVER2
GO DOVERT
YSV2: CALL YSRCH2
GO DOVER2
YSV1: CALL YSRCH1
GO DOVER2
POP0J
DOVERT: CALL(MKY↑,V1,[.RLARW])
DAC 1,Y1
CALL(MKY,V2,[.RLARW])
DAC 1,Y2
LAC 0,1(E1)
DAC 0,-1(Y1)
DAC 0,-1(Y2)
PARRW. Y1,Y2
PARRW. Y2,Y1
PVT. V1,Y1
PVT. V2,Y2
DOVER2: LAC K6
DAC OFFSET(Y1)
DAC OFFSET(Y2)
LDB 0,[POINT 3,(Y1),12]
JUMPN 0,L2
MOVEI 0,1
L2: DPB 0,[POINT 3,(Y1),12]
DPB 0,[POINT 3,(Y2),12]
PUSHP 0
PUSHP Y1
CALL(GEODPY)
POPP Y1
PARRW Y2,Y1
POPP 0
OKQ: OUTSTR[ASCIZ/
OK? /]↔ CALL(GETCHW)
ANDI 1,177
CAIE 1,"*"
CAIN 1,"-"
GO [ CAIN 1,"*"
SKIPA 1,K6
MOVN 1,K6
SKIPGE OFFSET(Y1)
MOVN 1,1
REDO: FADRM 1,OFFSET(Y1)
FADRM 1,OFFSET(Y2)
SKIPN OFFSET(Y1)
GO REDO
GO L2 ]
CAIN 1,"+"
GO SW
CAIE 1,"/"
CAIN 1,"\"
GO [ CAIN 1,"/"
SKIPA 1,[0.5]
MOVSI 1,(2.0)
FMPRM 1,K6
SKIPE FOOFLG
GO L2
FMPRM 1,OFFSET(Y1)
FMPRM 1,OFFSET(Y2)
GO L2 ]
CAIL 1,"a"
ANDI 1,137
CAIE 1,"."
CAIN 1,"N"
GO [ ADDI 0,1
CAILE 0,6
MOVEI 0,1
SW: MOVNS OFFSET(Y1)
MOVNS OFFSET(Y2)
GO L2 ]
CAIN 1,","
GO [ SOJG 0,L2
MOVEI 0,6
GO SW ]
CAIN 1,"H"
GO [ OUTSTR HLPMSG
GO OKQ ]
CAIN 1,"Y"
GO [ OUTSTR[ASCIZ/
*/]↔ POP0J ]
OUTSTR[ASCIZ|Respond Y H . , / \ * - +|]
GO OKQ
K6: 10.0
YSRCH1: LAC Y1,V1
PY Y1,Y1
JUMPE Y1,[AOS(P)↔POP0J]
YCODE 0,Y1
CAIE 0,$ARROW
GO YSRCH1+1
PARRW Y2,Y1
PVT V2,Y2
POP0J
YSRCH2: LAC Y1,V1
PY Y1,Y1
JUMPE Y1,[AOS(P)↔POP0J]
YCODE 0,Y1
CAIE 0,$ARROW
GO YSRCH2+1
YSRCH3: LAC Y2,V2
PY Y2,Y2
JUMPE Y2,YSRCH2+1
PARRW 0,Y2
CAME 0,Y1
GO YSRCH3+1
POP0J
HLPMSG: ASCIZ|'Y': Yes 'H' Help '.': Next position ',' Previous position
/ Half offset \ Double offset * expand - contract + other side |
DECLARE{FOOFLG}
ENDR XARROW
SUBR(STADPY) ;STATUS DISPLAY
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN DECDPY,DPYSTR,DTYO,DPYBRT
EXTERN AIVECT,AVECT,BUFDPY,FLODPY,DPYOUT,DPYSET,DPYBUF
CALL(DPYSET,DPYBUF)
SKIPN FLAGSD↔GO L4 ;STATUS DISPLAY INHIBIT.
YDEL ←← -=45
;STATUS OF FRAME SELECT.
CALL(AIVECT,[=180],[=500+YDEL])
LAC 1,FRAAM
PUSH P,[
[ASCIZ/WORLD/]
[ASCIZ/BODY/]
[ASCIZ/RELATIVE/]
[ASCIZ/CAMERA/]](1)
CALL(DPYSTR)
;STATUS OF FRAME ORIGIN SWITCH.
LACI[ASCIZ/ FRAME/]
SKIPE FRMORG
LACI[ASCIZ/ FRAME */]
CALL(DPYSTR,0)
;STATUS OF OPERAT SELECT SWITCH.
CALL(AIVECT,[=365],[=500+YDEL])
LAC 1,OPERAT
PUSH P,[
[ASCIZ/TRANSLATION/]
[ASCIZ/ROTATION/]
[ASCIZ/DILATION/]
[ASCIZ/REFLECTION/]](1)
CALL(DPYSTR)
;----- STADPY ;TRANSLATION STRENGTH.
CALL(AIVECT,[=185],[=480+YDEL])
CALL(FLODPY,TDEL,[4])
CALL(DPYSTR,{[[ASCIZ/ FEET/]]})
;ROTATION STRENGTH IN PI FRACTION.
CALL(AIVECT,[=185],[=460+YDEL])
L1: LAC RDEL↔LAC 1,[3.15]
CAMLE[6.28]↔GO L2
CAML[2.0]↔GO[FSC 1,1↔PUSH P,1
CALL(DTYO,["2"])↔POP P,1
GO .+1]
FDVR 1,RDEL↔FIX 1,233000↔PUSH P,1
CALL(DPYSTR,{[[ASCIZ"π/"]]})
CALL(DECDPY)
L2:
;ROTATION STRENGTH IN RADIANS.
CALL(AIVECT,[=400],[=460+YDEL])
CALL(FLODPY,RDEL,[3])
;RDEL IN DEGREES, MINUTES AND SECONDS.
CALL(AIVECT,[=270],[=460+YDEL])
LAC 1,RDEL
FMPR 1,[206264.806]
FIX 1,233000
AOS 1
IDIVI 1,=3600
IDIVI 2,=60
PUSH P,3
PUSH P,2
PUSH P,1
CALL(DECDPY)↔CALL(DTYO,[" "])
CALL(DECDPY)↔CALL(DTYO,[" "])
CALL(DECDPY)
;DILATION STRENGTH.
CALL(AIVECT,[=390],[=480+YDEL])
LAC DDEL↔FMP[100.0]↔FADR[0.001]
CALL(FLODPY,0,[2])
CALL(DTYO,["%"])
CALL(DTYO,[" "])
LAC AXECNT↔ADDI 60↔CALL(DTYO,0)
;----- STADPY DISPLAY THE SCRATCH PAD PDL.
CALL(AIVECT,[-=511],[=430])
CDR 16,PDLPTR
CAILE 16,PADPDL↔GO[
CALL(IDPY,{(16)})
CALL(NTYPE,{(16)})
CAIN 1,$YNODE↔GO $.+3
CAIG 1,$BODY↔GO NOTFEV
CALL(DPYSTR,[[ASCIZ/ of /]])
CALL(BGET,{(16)})
CALL(IDPY,1)
NOTFEV: CALL(DTYO,[15])↔CALL(DTYO,[12])
SOJA 16,.-1]
SKIPN FLAGL↔GO L3
;DISPLAY TOP OBJECT OF PADPDL.
CDR 16,PDLPTR↔CAILE 16,PADPDL
GO[CALL(DPYTOP,{(16)})↔GO .+1]
;DISPLAY THE SECOND OBJECT WHEN APPROPRIATE.
CDR 16,PDLPTR↔CAILE 16,PADPDL+1
GO[ LAC 1,-1(16)↔LAC 2,(16)
LAC 0,(1)↔IOR 0,(2)↔LDB[POINT 3,0,16]
CAIE 6↔CAIN 3↔SKIPA↔GO .+1
CALL(LINKED,1,2)↔JUMPE 1,.+1
CALL(DPYTOP,{-1(16)})
GO .+1]
L3: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔GO L4↔LAC 1,(1)
SKIPE FLAGD↔GO[CALL(DPYNODE,1)↔GO L4]
L4: CALL(DPYOUT,[0])
POP0J
ENDR STADPY;2-FEB-73(BGB)
SUBR(NTYPE,NODE) ;FETCH NODE TYPE NUMBER 0 TO 17.
COMMENT ⊗------------------------------------------------------------
⊗↔ LAC 1,@NODE ;TYPE BITS WORD.
SKIPGE 1↔SETZ 1, ;NEGATIVE BIT.
TLNE 1,(1B9)↔SETZ 1, ;NORMALIZATION BIT.
ANDI 1,17↔POP1J
ENDR NTYPE;3/25/73(BGB)----------------------------------------------
SUBR(DPYTOP,OBJECT) ;SPECIAL ENTITY DISPLAY.
COMMENT ⊗------------------------------------------------------------
⊗↔ CALL(NTYPE,OBJECT)
CAIGE 1,$YNODE↔POP1J
GO @[ POP1J. ;YNODE
POP1J. ;ZNODE
POP1J. ;BODY
FDPY ;FACE
EDPY ;EDGE
VDPY ;VERTEX
]-$YNODE(1)
ENDR DPYTOP;---------------------------------------------------------
;TABLES REL,CONTYP,NNAMES,NLETTER ;Node Info. Tables
;NODE RELLOCATION BITS.
; 0 1 2| 3 4 5| 6 7 8| 9 10 11|12 13 14|15 16 17| ← BIT.
; | 8 7 6| 5 4 3| 2 1 0|-1 -2 -3| ← WORD.
REL↑:
BEGIN REL
L8←←<(4000)>↔ R8←←4000 ↔ L7←←<(2000)>↔ R7←←2000
L6←←<(1000)>↔ R6←←1000 ↔ L5←←<(400)>↔ R5←← 400
L4←←<(200)>↔ R4←← 200 ↔ L3←←<(100)>↔ R3←← 100
L2←← <(40)>↔ R2←← 40 ↔ L1←← <(20)>↔ R1←← 20
NL1←← <(4)>↔NR1←← 4 ↔ NL2←← <(2)>↔NR2←← 2
NL3←← <(1)>↔NR3←← 1
0 ↔ NR3 ;FRAME & EMPTY.
L7+R7+L4+R4+NR2 ;UNIVERSE.
L6+R5+L5 ;LAMP.
L7+R7 + R6 + L5+R5 +R4 ;CAMERA.
L7+R7 + L6+R6 + L5+R5 + L4+R4 ;WORLD.
L7+R7 + L5+R5 + L4 ;WINDOW.
L7+R7 + L6+R6 + L5+R5 + L4+R4 ;IMAGE.
XWD 0004, 0004 ;TEXT.
0↔0↔0 ;X,Y,Z NODES.
XWD 3760, 3760 ;BODY.
XWD 1020, 1060 ;FACE.
XWD 3760, 3760 ;EDGE.
XWD 0140, 0140 ;VERTEX.
BEND
NLETTER↑: ;NODE INITIALS.
"R" ↔ "M" ↔ "U" ↔ "S"
"C" ↔ "W" ↔ "D" ↔ "I"
"T" ↔ "X" ↔ "Y" ↔ "Z"
"B" ↔ "F" ↔ "E" ↔ "V"
NNAMES↑: ;NODE NAMES
[ASCIZ"FRAME"]↔[ASCIZ"EMPTY"]↔[ASCIZ"UNIVERSE"]↔[ASCIZ"SUN"]
[ASCIZ"CAMERA"]↔[ASCIZ"WORLD"]↔[ASCIZ"WINDOW"]↔[ASCIZ"IMAGE"]
[ASCIZ"TEXT"]↔[ASCIZ"XNODE"]↔[ASCIZ"YNODE"]↔[ASCIZ"ZNODE"]
[ASCIZ"BODY"]↔[ASCIZ"FACE"]↔[ASCIZ"EDGE"]↔[ASCIZ"VERTEX"]
SUBR(JDPY,NODE) ;DISPLAY NODE'S NUMERAL.
SKIPN 1,NODE↔GO[
CALL(DPYSTR,{[[ASCIZ/NIL/]]})↔POP1J]
CAMGE 1,UNIVERSE↔GO L
CAML 1,44↔GO L
CALL(NTYPE,1)
CALL(DTYO,{NLETTER(1)})
L: CALL({OCTDPY+1},NODE)
POP1J
ENDR JDPY;3/25/73(BGB)-----------------------------------------------
;NODE CONTENT TYPES.
COMMENT ⊗
0 -- EMPTY.
1 -- OCTAL WORD.
2 -- ASCII.
3 -- REAL.
4 -- NODE.
| 8 7 6| 5 4 3| 2 1 0|-1 -2 -3| ← WORD.
⊗
CONTYP:
BYTE(9)333,333,333,333 ;FRAME.
BYTE(9)000,000,000,000 ;EMPTY.
BYTE(9)040,040,001,000 ;UNIVERSE.
BYTE(9)000,400,001,000 ;LAMP.
BYTE(9)044,440,001,000 ;CAMERA.
BYTE(9)044,440,441,220 ;WORLD.
BYTE(9)040,440,001,300 ;WINDOW.
BYTE(9)044,440,001,000 ;IMAGE.
BYTE(9)000,000,001,000 ;TEXT.
0 ;XNODE.
0 ;YNODE.
0 ;ZNODE.
BYTE(9)044,444,441,220 ;BODY.
BYTE(9)004,113,041,333 ;FACE.
BYTE(9)044,444,441,000 ;EDGE.
BYTE(9)003,334,411,333 ;VERTEX.
SUBR(DPYNODE,NODE) ;DISPLAY NODE CONTENTS.
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN AIVECT,AVECT,DPYBIG
EXTERN DTYO,DPYSTR,FLODPY,DECDPY,OCTDPY
;BOX IN LOWER RIGHT HAND CORNER OF THE SCREEN
CALL(AIVECT,[=260],[-=70])
CALL(AVECT,[=260],[-=380])
CALL(AVECT,[=508],[-=380])
CALL(AVECT,[=508],[-=70])
CALL(AVECT,[=260],[-=70])
CALL(DPYBIG,[1])↔CALL(JDPY,NODE)↔SKIPN NODE↔POP1J
CALL(DPYSTR,{[[ASCIZ" "]]})
SETQ(KIND,{NTYPE,NODE})
LAC [POINT 7,LNKCHR]↔DAC LNKPTR
CAIN 1,$YNODE
GO [ LAC 2,NODE↔LAC 0,YREL(2)↔GO .+2 ] ;YNODES
LAC REL(1)↔DAC RELTMP ;RELLOCATION.
LAC CONTYP(1)↔DAC CONTMP ;CONTENT TYPE.
LAC NNAMES(1)↔CALL(DPYSTR,0)
NIM -3↔DAC WRD
L1:
LACN WRD↔IMULI =25↔SUBI =170↔DAC Y
CALL(AIVECT,[=265],Y)
ILDB 1,LNKPTR ;PICK UP LINK CHARACTERS (LEFT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BETWEEN THEM
ILDB 1,LNKPTR ;(RIGHT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BEFORE A NUMBER
SKIPGE WRD↔GO .+3↔CALL(DTYO,[" "]) ;AND ANOTHER IF NOT NEGATIVE
CALL(DECDPY,WRD)
;FULL WORD.
CALL(AIVECT,[=345],Y)
LACN 2,WRD↔LAC CONTMP
ROT(2)↔ROT(2)↔ROT(2)↔ANDI 7000
CAIN 3000↔GO[LAC 1,NODE↔ADD 1,WRD
CALL(FLODPY,{(1)},[4])↔GO L2]
;LEFT HALF.
CALL(AIVECT,[=345],Y)
LAC 1,NODE↔ADD 1,WRD↔CAR(1)↔PUSH P,0
LACN 2,WRD↔CAR RELTMP↔ROT(2)
TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY+1})
;RIGHT HALF.
CALL(AIVECT,[=425],Y)
LAC 1,NODE↔ADD 1,WRD↔CDR(1)↔PUSH P,0
LACN 2,WRD↔CDR RELTMP↔ROT(2)
TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY+1})
L2: AOS 1,WRD↔CAIG 1,8↔GO L1
CALL(DPYBIG,[2])
POP1J
LNKCHR: ASCIZ/ <>≤≥∨∧∩∪⊂⊃←→,./
DECLARE{WRD,X,Y,KIND,RELTMP,CONTMP,LNKPTR}
ENDR DPYNODE;3/25/73(BGB)--------------------------------------------
SUBR(SEENODE,NODE)---------------------------------------------------
PUSHACS
CALL(DPYSET,DPYBUF)
CALL(DPYNODE,NODE)
CALL(DPYTOP,NODE)
CALL(DPYOUT,[0])
POPACS
POP1J
ENDR SEENODE;5/4/73(TVR)---------------------------------------------
SUBR(VDPY,VERTEX) ;SPECIAL VERTEX DISPLAY *
LAC 1,VERTEX
TESTZ 1,NSEW+PZZ↔POP1J
XDC 0,1↔FIXX↔SUBI VERNX↔PUSH P,0
YDC 0,1↔FIXX↔SUBI VERNY↔PUSH P,0↔PUSHJ P,AIVECT
CALL(DPYBIG↑,[1])↔CALL(DPYBRT,[3])
CALL(IDPY,VERTEX)
CALL(DPYBIG↑,[2])↔CALL(DPYBRT,[2])
POP1J
ENDR VDPY;9-JAN-73(BGB)9-FEB-73(BGB)
SUBR(EDPY,EDGE) ;SPECIAL EDGE DISPLAY *
CALL(DPYBIG↑,[1])↔CALL(DPYBRT,[4])
LAC 2,EDGE↔PVT 1,2
TESTZ 1,NSEW!PZZ↔GO L1
XDC 0,1↔FIXX↔DAC X
YDC 0,1↔FIXX↔DAC Y↔CALL(AIVECT,X,Y)
CALL(DTYO,["+"])↔ CALL(AIVECT,X,Y)
L1: LAC 2,EDGE↔NVT 1,2
TESTZ 1,NSEW!PZZ↔GO L2
XDC 0,1↔FIXX↔ADDM X↔PUSH P,
YDC 0,1↔FIXX↔ADDM Y↔PUSH P,↔CALL(AVECT)
CALL(DTYO,["-"])
L2: LAC 2,EDGE
LAC X↔ASH -1↔PUSH P,
LAC Y↔ASH -1↔PUSH P,↔CALL(AIVECT)
CALL(IDPY,EDGE)
CALL(DPYBIG,[2])
CALL(DPYBRT↑,[2])
CALL(AIVECT,[0],[0]) ;FORCE BIG & BRT RESET.
POP1J
DECLARE{X,Y}
ENDR EDPY;9-FEB-73(BGB)
SUBR(FDPY,FACE) ;Special Face display *
EXTERN ECCW
LAC 1,FACE↔DAC 1,F↔TEST 1,FBIT↔POP1J
PED 2,1↔DAC 2,E↔DAC 2,E0↔JUMPE 2,POP1J.
SETZM I
CALL(DPYBIG,[1])
CALL(DPYBRT↑,[3])
SKIPN E↔GO[LAC 1,F↔PFACE 1,1↔PVT 1,1↔GO VDPY+1]
L1: AOS I↔LAC 2,E↔TEST 2,VISIBLE↔GO L2
X1DC 0,2↔DAC 0,X
Y1DC 1,2↔DAC 1,Y
CALL(AIVECT,0,1)↔LAC 2,E
X2DC 0,2↔ADDM 0,X
Y2DC 1,2↔ADDM 1,Y
CALL(AVECT,0,1)
LAC 0,X↔ASH 0,-1↔SUBI 0,VERNX
LAC 1,Y↔ASH 1,-1↔SUBI 1,VERNY
CALL(AIVECT,0,1)
CALL(DECDPY,I)
L2: CALL(ECCW,E,F)
CAMN 1,E↔GO L3↔DAC 1,E
CAME 1,E0↔GO L1
L3: CALL(DPYBRT↑,[2])
CALL(DPYBIG,[2])
POP1J
DECLARE{F,E,E0,X,Y,I}
ENDR FDPY;9-FEB-73(BGB)
SUBR(IDPY,NODE) ;Identifier display. *
;--------------------------------------------------------------------
SKIPN NODE↔GO[CALL(DPYSTR,{[[ASCIZ/NIL/]]})↔POP1J]
CALL(NTYPE,NODE)↔CAIGE 1,$BODY↔GO L5
LAC 1,NODE↔SETZ 2,
TESTZ 1,BBIT↔GO[
SKIPE 13,-2(1)↔GO[
LAC 14,-1(1)↔DZM 15
CALL(DPYSTR,[13])↔POP1J]
L1: CW 1,1↔TESTZ 1,BBIT↔AOJA 2,L1
AOS 2↔PUSH P,2↔CALL(DTYO,["B"])
CALL(DECDPY)↔POP1J]
TESTZ 1,FBIT↔GO[
L2: NFACE 1,1↔TESTZ 1,FBIT↔AOJA 2,L2
AOS 2↔PUSH P,2↔CALL(DTYO,["F"])
CALL(DECDPY)↔POP1J]
TESTZ 1,EBIT↔GO[
L3: NED 1,1↔TESTZ 1,EBIT↔AOJA 2,L3
AOS 2↔PUSH P,2↔CALL(DTYO,["E"])
CALL(DECDPY)↔POP1J]
TESTZ 1,VBIT↔GO[
L4: NVT 1,1↔TESTZ 1,VBIT↔AOJA 2,L4
AOS 2↔PUSH P,2↔CALL(DTYO,["V"])
CALL(DECDPY)↔POP1J]
CALL NTYPE,NODE
L5: CALL DPYSTR,NNAMES(1)
LAC 1,NODE↔CAMN 1,UNIVERSE↔POP1J
$TYPE 2,1↔DZM 5 ;NODE - TYPE - COUNT.
LAC 3,UNIVERSE↔SON 3,3↔DAC 3,4 ;SON0 - SON.
CAME 1,4↔GO[$TYPE 0,4↔CAMN 0,2↔AOS 5↔SIS 4,4
CAME 3,4↔GO .-1↔GO .+1]↔AOS 5
CALL(DECDPY,5)
POP1J
ENDR IDPY;2/4/73(BGB)------------------------------------------------
IFE SAIL{END SA}
IFN SAIL{END}
GEOMED.FAI - EOF.